home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / DELPHI32 / GRAPHICS / IMGLIB95 / UFGRAB.PA_ / UFGRAB.PA
Text File  |  1996-03-31  |  4KB  |  151 lines
  1. {
  2. Written by Jan Dekkers and Kevin Adams (c) 1995, 1996. If you are a non
  3. registered client, you may use or alter this demo only for evaluation
  4. purposes.
  5.  
  6. Copyright by SkyLine Tools. All rights reserved.
  7.  
  8. Part of Imagelib VCL/DLL Library.
  9. }
  10.  
  11. unit Ufgrab;
  12.  
  13. {Includes settings to compile in either 16 or 32 bit}
  14. {$I DEFILIB.INC}
  15.  
  16. interface
  17.  
  18. uses
  19. {$IFDEF DEL32}
  20.   Windows,
  21. {$ELSE}
  22.   WinTypes,
  23.   WinProcs,
  24. {$ENDIF}
  25.   DLL95V1,    {ImageLib Dll interface and misc. functions}
  26.   SysUtils,
  27.   Messages,
  28.   Classes,
  29.   Graphics,
  30.   Controls,
  31.   Forms,
  32.   Dialogs,
  33.   MPlayer,
  34.   StdCtrls,
  35.   Buttons,
  36.   MMOpen,   {Visual OpenDialog box}
  37.   TMultiMP, {PMultiMedia VCL component}
  38.   TMultiP;  {PMultiImage VCL component}
  39.  
  40. type
  41.   TFrameGrab = class(TForm)
  42.     BitBtn1: TBitBtn;
  43.     PMultiMedia1: TPMultiMedia;
  44.     MMOpenDialog1: TMMOpenDialog;
  45.     Button1: TButton;
  46.     MIMediaPlayer1: TMIMediaPlayer;
  47.     Button2: TButton;
  48.     Memo1: TMemo;
  49.     GroupBox3: TGroupBox;
  50.     CTOJPEG: TRadioButton;
  51.     CTOBMP: TRadioButton;
  52.     CTOGIF: TRadioButton;
  53.     CTOPCX: TRadioButton;
  54.     CTOPNG: TRadioButton;
  55.     CTOTIF: TRadioButton;
  56.     Edit1: TEdit;
  57.     Label1: TLabel;
  58.     PMultiImage1: TPMultiImage;
  59.     Label2: TLabel;
  60.     procedure BitBtn1Click(Sender: TObject);
  61.     procedure Button1Click(Sender: TObject);
  62.     procedure Button2Click(Sender: TObject);
  63.     procedure SaveAsChange(Sender: TObject);
  64.   private
  65.     { Private declarations }
  66.   public
  67.     { Public declarations }
  68.   end;
  69.  
  70. var
  71.   FrameGrab: TFrameGrab;
  72.  
  73. implementation
  74.  
  75. {$R *.DFM}
  76. {------------------------------------------------------------------------}
  77. procedure TFrameGrab.BitBtn1Click(Sender: TObject);
  78. begin
  79.      {Capture a video frame and display it}
  80.      PMultiImage1.VideoToPicture(PMultiMedia1.Handle);
  81. end;
  82. {------------------------------------------------------------------------}
  83.  
  84. procedure TFrameGrab.Button1Click(Sender: TObject);
  85. begin
  86.   {Open a video file}
  87.   If MMOpenDialog1.Execute then
  88.     PMultiMedia1.MediaName:=MMOpenDialog1.Filename;
  89. end;
  90. {------------------------------------------------------------------------}
  91.  
  92. procedure TFrameGrab.Button2Click(Sender: TObject);
  93. begin
  94.   Label2.Caption:='';
  95.  
  96.   {Save the captured image to a file}
  97.   PMultiImage1.ImageWriteRes:=sColor256;
  98.  
  99.   {Force extension}
  100.   SaveAsChange(Sender);
  101.  
  102.   screen.cursor:=crHourGlass;
  103.  
  104.   if CTOJPEG.Checked then
  105.         PMultiImage1.SaveAsJpg(Edit1.Text)
  106.   else
  107.  
  108.   if CTOBMP.Checked then
  109.         PMultiImage1.SaveAsBMP(Edit1.Text)
  110.   else
  111.  
  112.   if CTOTIF.Checked then
  113.         PMultiImage1.SaveAsTIF(Edit1.Text)
  114.   else
  115.  
  116.   if CTOGIF.Checked then
  117.         PMultiImage1.SaveAsGIF(Edit1.Text)
  118.   else
  119.  
  120.   if CTOPCX.Checked then
  121.         PMultiImage1.SaveAsPCX(Edit1.Text)
  122.   else
  123.  
  124.   if CTOPNG.Checked then
  125.         PMultiImage1.SaveAsPNG(Edit1.Text);
  126.  
  127.   screen.cursor:=crDefault;
  128.   Label2.Caption:='Saved';
  129. end;
  130. {------------------------------------------------------------------------}
  131.  
  132. procedure TFrameGrab.SaveAsChange(Sender: TObject);
  133. begin
  134.  {Change extension}
  135.  if CTOJPEG.Checked then
  136.     Edit1.Text:=ChangeFileExt(Edit1.Text, '.JPG');
  137.  if CTOBMP.Checked then
  138.     Edit1.Text:=ChangeFileExt(Edit1.Text, '.BMP');
  139.  if CTOGIF.Checked then
  140.     Edit1.Text:=ChangeFileExt(Edit1.Text, '.GIF');
  141.  if CTOPCX.Checked then
  142.     Edit1.Text:=ChangeFileExt(Edit1.Text, '.PCX');
  143.  if CTOPNG.Checked then
  144.     Edit1.Text:=ChangeFileExt(Edit1.Text, '.PNG');
  145.  if CTOTIF.Checked then
  146.     Edit1.Text:=ChangeFileExt(Edit1.Text, '.TIF');
  147. end;
  148. {------------------------------------------------------------------------}
  149.  
  150. end.
  151.